home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / drawing.bas < prev    next >
BASIC Source File  |  1998-12-15  |  4KB  |  100 lines
  1. Attribute VB_Name = "modDrawing"
  2. Option Explicit
  3. Public Sub DrawBox(Object As Object, ByVal Left As _
  4.     Single, ByVal Top As Single, ByVal Width As Single, _
  5.     ByVal Height As Single, Down As Boolean, Optional _
  6.     Filled As Boolean = True, Optional FillColor As _
  7.     Long = vb3DFace)
  8.  
  9.     On Error Resume Next
  10.     Dim m_clr1 As OLE_COLOR
  11.     Dim m_clr2 As OLE_COLOR
  12.     Dim m_clr3 As OLE_COLOR
  13.     Dim m_clr4 As OLE_COLOR
  14.     Dim CX As Single
  15.     Dim CY As Single
  16.     Dim PX As Long, PY As Long
  17.     CX = Object.CurrentX
  18.     CY = Object.CurrentY
  19.     PX = Screen.TwipsPerPixelX
  20.     PY = Screen.TwipsPerPixelY
  21.     If Not Down Then
  22.         m_clr1 = vb3DFace
  23.         m_clr2 = vb3DDKShadow
  24.         m_clr3 = vb3DHighlight
  25.         m_clr4 = vb3DShadow
  26.     Else
  27.         m_clr1 = vb3DDKShadow
  28.         m_clr2 = vb3DFace
  29.         m_clr3 = vb3DShadow
  30.         m_clr4 = vb3DHighlight
  31.     End If
  32.     If Filled Then
  33.         Object.Line (Left, Top)-(Left + Width - PX, Top + Height - PY), FillColor, BF
  34.     End If
  35.     Object.Line (Left, Top)-(Left + Width - PX, Top), m_clr1
  36.     Object.Line (Left, (Top + Height) - PY)-(Left + Width, (Top + Height) - PY), m_clr2
  37.     Object.Line (Left, Top + Height - PY)-(Left, Top), m_clr1
  38.     Object.Line (Left + Width - PX, Top)-(Left + Width - PX, (Top + Height) - PY), m_clr2
  39.     Object.Line (Left + PX, Top + PY)-(Left + Width - (PX * 2), Top + PY), m_clr3
  40.     Object.Line (Left + PX, (Top + Height) - (PY * 2))-(Left + Width - (PX), (Top + Height) - (PY * 2)), m_clr4
  41.     Object.Line (Left + PX, Top + Height - (PY * 2))-(Left + PX, Top + PY), m_clr3
  42.     Object.Line (Left + Width - (PX * 2), Top + PY)-(Left + Width - (PX * 2), (Top + Height) - (PY * 2)), m_clr4
  43.     Object.CurrentX = CX
  44.     Object.CurrentY = CY
  45. End Sub
  46. Public Sub DrawFocusRect(Object As Object, Left As _
  47.     Single, Top As Single, Width As Single, Height _
  48.     As Single, Color As Long)
  49.     
  50.     Dim m_lngLoop As Long
  51.     For m_lngLoop = 1 To Width \ 30 + 1
  52.         Object.PSet (Left + m_lngLoop * 30 - 30, Top), Color
  53.         If Not m_lngLoop = 1 Then
  54.             Object.PSet (Left + m_lngLoop * 30 - 30, Top + Height), Color
  55.         End If
  56.     Next
  57.     For m_lngLoop = 1 To (Height \ 30) + 1
  58.         Object.PSet (Left, Top + m_lngLoop * 30 - 30), Color
  59.         If Not m_lngLoop = 1 Then
  60.             Object.PSet (Left + Width, Top + m_lngLoop * 30 - 30), Color
  61.         End If
  62.     Next
  63. End Sub
  64. Public Sub Draw3DCircle(Object As Object, ByVal X As Single, ByVal Y As Single, ByVal Radius As Integer, Optional ByVal BackColor As Long = vbButtonFace, Optional ByVal Filled As Boolean = -1, Optional Down As Boolean)
  65. Radius = Radius \ 15
  66. Radius = Radius * 15
  67. If Not Down Then
  68. Draw2ColorCirc Object, vbButtonFace, vb3DShadow, X, Y, Radius, BackColor, Filled
  69. Draw2ColorCirc Object, vb3DHighlight, vb3DDKShadow, X, Y, Radius - 15, BackColor, Filled
  70. Else
  71. Draw2ColorCirc Object, vb3DShadow, vbButtonFace, X, Y, Radius, BackColor, Filled
  72. Draw2ColorCirc Object, vb3DDKShadow, vb3DHighlight, X, Y, Radius - 15, BackColor, Filled
  73. End If
  74. End Sub
  75. Private Sub Draw2ColorCirc(Object As Object, ByVal Color1 As Long, ByVal Color2 As Long, ByVal X As Single, ByVal Y As Single, ByVal Radius As Integer, Optional ByVal BackColor As Long = vbButtonFace, Optional ByVal Filled As Boolean = -1)
  76. Dim m_intDrawSty As Integer
  77. If Filled Then
  78. m_intDrawSty = Object.DrawStyle
  79. Object.DrawStyle = vbSolid
  80. Object.FillColor = BackColor
  81. Object.Line ((X - Radius + (Radius / 2)) - 15, (Y - Radius + (Radius / 2)) - 15)-((X - Radius + Radius * 1.5) + 15, (Y - Radius + Radius * 1.5) + 15), BackColor, BF
  82. Object.Circle (X, Y), Radius - 15, BackColor
  83. Object.DrawStyle = m_intDrawSty
  84. End If
  85. Object.Circle (X, Y), Radius, Color1, 1, 4
  86. Object.Circle (X, Y), Radius, Color2, 4, 6.25
  87. Object.Circle (X, Y), Radius, Color2, 0, 1
  88. End Sub
  89. Public Sub DrawCross(Object As Object, X, Y, Color As Long)
  90. Dim mDrawWidth%
  91. mDrawWidth% = Object.DrawWidth
  92. Object.DrawWidth = 2
  93. Object.Line (X + 120, Y)-(X + 120, Y + 90), Color
  94. Object.Line (X + 120, Y + 150)-(X + 120, Y + 240), Color
  95. Object.Line (X, Y + 120)-(X + 90, Y + 120), Color
  96. Object.Line (X + 150, Y + 120)-(X + 240, Y + 120), Color
  97. Object.DrawWidth = mDrawWidth%
  98. End Sub
  99.  
  100.